(define-syntax chain
  (lambda (x)
    (syntax-case x ()
      ((_ initial-value placeholder ellipsis (step ...) rest ...)
        (and (identifier? #'placeholder)
             (identifier? #'ellipsis))
        (let loop ((vars '()) (out '()) (in #'(step ...)))
          (syntax-case in ()
            ((u …) (and (id=? #'u #'placeholder) (id=? #'… #'ellipsis))
              (with-syntax ((chain-rest-var (genident))
                            ((vars* ...) (reverse vars))
                            ((out* ...) (reverse out)))
                #`(chain (call-with-values
                           (lambda () initial-value)
                           (lambda
                             #,(if (null? vars)
                                 #'chain-rest-var
                                 #'(vars* ... . chain-rest-var))
                             (apply out* ... chain-rest-var)))
                         placeholder
                         ellipsis
                         rest ...)))
            ((u … . _) (and (id=? #'u #'placeholder) (id=? #'… #'ellipsis))
              (syntax-violation 'chain "_ ... only allowed at end" #'(step ...)))
            ((u . step-rest) (id=? #'u #'placeholder)
              (let ((chain-var (genident)))
                (loop (cons chain-var vars) (cons chain-var out) #'step-rest)))
            ((… . _) (id=? #'… #'ellipsis)
              (syntax-violation 'chain "misplaced ..." #'(step ...)))
            ((x . step-rest)
              (loop vars (cons #'x out) #'step-rest))
            (()
              (with-syntax ((result (reverse out)))
                #`(chain
                    #,(cond
                        ((null? vars)
                          #'(begin initial-value result))
                        ((null? (cdr vars))
                          #`(let ((#,(car vars) initial-value)) result))
                        (else
                          #`(let-values ((#,(reverse vars) initial-value)) result)))
                    placeholder
                    ellipsis
                    rest ...))))))
      ((_ initial-value placeholder ellipsis) (and (identifier? #'placeholder)
                                                   (identifier? #'ellipsis))
        #'initial-value)
      ((optr initial-value placeholder step ...) (identifier? #'placeholder)
        #`(chain initial-value
                 placeholder
                 #,(datum->syntax #'optr '...)
                 step ...))
      ((optr initial-value step ...)
        #`(chain initial-value
                 #,(datum->syntax #'optr '_)
                 #,(datum->syntax #'optr '...)
                 step ...)))))

(define-syntax chain-and
  (lambda (x)
    (syntax-case x ()
      ((_ initial-value placeholder (step ...) rest ...) (identifier? #'placeholder)
        (let loop ((var #f) (out '()) (in #'(step ...)))
          (syntax-case in ()
            ((u . step-rest) (id=? #'u #'placeholder)
              (if var
                (syntax-violation 'chain-and "only one _ allowed per step" #'(step ...))
                (let ((chain-var (genident)))
                  (loop chain-var (cons chain-var out) #'step-rest))))
            ((x . step-rest)
              (loop var (cons #'x out) #'step-rest))
            (()
              (with-syntax ((result (reverse out)))
                #`(chain-and
                    #,(if var
                        #`(let ((#,var initial-value))
                            (and #,var result))
                        #'(and initial-value result))
                    placeholder
                    rest ...))))))
      ((_ initial-value placeholder) (identifier? #'placeholder)
        #'initial-value)
      ((optr initial-value step ...)
        #`(chain-and initial-value
                     #,(datum->syntax #'optr '_)
                     step ...)))))

(define-syntax chain-when
  (lambda (x)
    (syntax-case x ()
      ((_ initial-value placeholder (guard? (step ...)) rest ...) (identifier? #'placeholder)
        (let loop ((var #f) (out '()) (in #'(step ...)))
          (syntax-case in ()
            ((u . step-rest) (id=? #'u #'placeholder)
              (if var
                (syntax-violation 'chain-when "only one _ allowed per step" #'(step ...))
                (let ((chain-var (genident)))
                  (loop chain-var (cons chain-var out) #'step-rest))))
            ((x . step-rest)
              (loop var (cons #'x out) #'step-rest))
            (()
              (with-syntax ((result (reverse out)))
                #`(chain-when
                    #,(if var
                        #`(let ((#,var initial-value))
                            (if guard? result #,var))
                        #'(let ((chain-var initial-value))
                            (if guard? result chain-var)))
                    placeholder
                    rest ...))))))
      ((_ initial-value placeholder) (identifier? #'placeholder)
        #'initial-value)
      ((optr initial-value step ...)
        #`(chain-when initial-value
                      #,(datum->syntax #'optr '_)
                      step ...)))))

(define-syntax chain-lambda
  (lambda (x)
    (syntax-case x ()
      ((_ placeholder ellipsis (first-step ...) rest ...) (and (identifier? #'placeholder)
                                                               (identifier? #'ellipsis))
        (let loop ((vars '()) (out '()) (in #'(first-step ...)))
          (syntax-case in ()
            ((u …) (and (id=? #'u #'placeholder) (id=? #'… #'ellipsis))
              (with-syntax ((chain-rest-var (genident))
                            ((vars* ...) (reverse vars))
                            ((out* ...) (reverse out)))
                #`(lambda #,(if (null? vars)
                              #'chain-rest-var
                              #'(vars* ... . chain-rest-var))
                    (chain (apply out* ... chain-rest-var) placeholder ellipsis rest ...))))
            ((u … . _) (and (id=? #'u #'placeholder) (id=? #'… #'ellipsis))
              (syntax-violation 'chain-lambda "_ ... only allowed at end" #'(first-step ...)))
            ((u . step-rest) (id=? #'u #'placeholder)
              (let ((chain-var (genident)))
                (loop (cons chain-var vars) (cons chain-var out) #'step-rest)))
            ((… . _) (id=? #'… #'ellipsis)
              (syntax-violation 'chain-lambda "misplaced ..." #'(first-step ...)))
            ((x . step-rest)
              (loop vars (cons #'x out) #'step-rest))
            (()
              #`(lambda #,(reverse vars) (chain #,(reverse out) placeholder ellipsis rest ...))))))
      ((optr placeholder step ...) (identifier? #'placeholder)
        #`(chain-lambda placeholder
                        #,(datum->syntax #'optr '...)
                        step ...))
      ((optr step ...)
        #`(chain-lambda #,(datum->syntax #'optr '_)
                        #,(datum->syntax #'optr '...)
                        step ...)))))

(define-syntax nest
  (lambda (x)
    (syntax-case x ()
      ((_ placeholder (extra-step ...) ... (step ...) last) (identifier? #'placeholder)
        (let loop ((arg #'last) (out '()) (in #'(step ...)))
          (syntax-case in ()
            ((u . step-rest) (id=? #'u #'placeholder)
              (if (eof-object? arg)
                (syntax-violation 'nest "only one _ allowed per step" #'(step ...))
                (loop (eof-object) (cons arg out) #'step-rest)))
            ((x . step-rest)
              (loop arg (cons #'x out) #'step-rest))
            (()
              (if (eof-object? arg)
                (with-syntax ((out* (reverse out)))
                  #'(nest placeholder (extra-step ...) ... out*))
                (syntax-violation 'nest "step must contain _" #'(step ...)))))))
      ((_ placeholder last) (identifier? #'placeholder) #'last)
      ((_ last) #'last)
      ((optr step ... last)
        #`(nest #,(datum->syntax #'optr '_) step ... last)))))

(define-syntax nest-reverse
  (lambda (x)
    (syntax-case x ()
      ((_ first placeholder (step ...) (extra-step ...) ...) (identifier? #'placeholder)
        (let loop ((arg #'first) (out '()) (in #'(step ...)))
          (syntax-case in ()
            ((u . step-rest) (id=? #'u #'placeholder)
              (if (eof-object? arg)
                (syntax-violation 'nest-reverse "only one _ allowed per step" #'(step ...))
                (loop (eof-object) (cons arg out) #'step-rest)))
            ((x . step-rest)
              (loop arg (cons #'x out) #'step-rest))
            (()
              (if (eof-object? arg)
                (with-syntax ((out* (reverse out)))
                  #'(nest-reverse out* placeholder (extra-step ...) ...))
                (syntax-violation 'nest-reverse "step must contain _" #'(step ...)))))))
      ((_ first placeholder) (identifier? #'placeholder) #'first)
      ((_ first) #'first)
      ((optr first step ...)
        #`(nest-reverse first #,(datum->syntax #'optr '_) step ...)))))
